home *** CD-ROM | disk | FTP | other *** search
/ Total Network Tools 2002 / NextStepPublishing-TotalNetworkTools2002-Win95.iso / Archive / Web Server / Savant.exe / disk1 / data1.cab / Perl5 / perl5 / lib / Text / abbrev.pm next >
Encoding:
Perl POD Document  |  2001-02-23  |  1.6 KB  |  87 lines
  1. package Text::Abbrev;
  2. require 5.000;
  3. require Exporter;
  4.  
  5. =head1 NAME
  6.  
  7. abbrev - create an abbreviation table from a list
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.     use Text::Abbrev;
  12.     abbrev $hashref, LIST
  13.  
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. Stores all unambiguous truncations of each element of LIST
  18. as keys key in the associative array referenced to by C<$hashref>.
  19. The values are the original list elements.
  20.  
  21. =head1 EXAMPLE
  22.  
  23.     $hashref = abbrev qw(list edit send abort gripe);
  24.  
  25.     %hash = abbrev qw(list edit send abort gripe);
  26.  
  27.     abbrev $hashref, qw(list edit send abort gripe);
  28.  
  29.     abbrev(*hash, qw(list edit send abort gripe));
  30.  
  31. =cut
  32.  
  33. @ISA = qw(Exporter);
  34. @EXPORT = qw(abbrev);
  35.  
  36. # Usage:
  37. #    &abbrev(*foo,LIST);
  38. #    ...
  39. #    $long = $foo{$short};
  40.  
  41. sub abbrev {
  42.     my (%domain);
  43.     my ($name, $ref, $glob);
  44.  
  45.     if (ref($_[0])) {           # hash reference preferably
  46.       $ref = shift;
  47.     } elsif ($_[0] =~ /^\*/) {  # looks like a glob (deprecated)
  48.       $glob = shift;
  49.     } 
  50.     my @cmp = @_;
  51.  
  52.     foreach $name (@_) {
  53.     my @extra = split(//,$name);
  54.     my $abbrev = shift(@extra);
  55.     my $len = 1;
  56.         my $cmp;
  57.     foreach $cmp (@cmp) {
  58.         next if $cmp eq $name;
  59.         while (substr($cmp,0,$len) eq $abbrev) {
  60.         $abbrev .= shift(@extra);
  61.         ++$len;
  62.         }
  63.     }
  64.     $domain{$abbrev} = $name;
  65.     while (@extra) {
  66.         $abbrev .= shift(@extra);
  67.         $domain{$abbrev} = $name;
  68.     }
  69.     }
  70.     if ($ref) {
  71.       %$ref = %domain;
  72.       return;
  73.     } elsif ($glob) {           # old style
  74.       local (*hash) = $glob;
  75.       %hash = %domain;
  76.       return;
  77.     }
  78.     if (wantarray) {
  79.       %domain;
  80.     } else {
  81.       \%domain;
  82.     }
  83. }
  84.  
  85. 1;
  86.  
  87.